home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / LIBRARY / PAS_0793 / NUMBASE.PAS < prev    next >
Pascal/Delphi Source File  |  1993-08-01  |  7KB  |  204 lines
  1. ─ Fido Pascal Conference ────────────────────────────────────────────── PASCAL ─
  2. Msg  : 305 of 322                                                               
  3. From : Mark Lewis                          1:3634/12.0          05 Jul 93  21:33 
  4. To   : all                                                                       
  5. Subj : (1 of 2) number base conversions                                       
  6. ────────────────────────────────────────────────────────────────────────────────
  7. {
  8. the following unit is based on original code by Lou Duchez. i have modified
  9. Lou's original and based it on a character array. Function dec2base is still
  10. very much like the code that Lou wrote. Function base2dec is all my code and
  11. reverses the dec2base result. you can convert from one base to another by
  12. converting to dec first... see sample program (2 of 2) for details...
  13.  
  14. BTW: no check is made for it, but we're only coded for Base 62. yes, 1A2 and
  15. 1a2 are two different numbers -=B-)
  16.  
  17. Original message quote to give appropraite credits...
  18.  
  19. (2547)  Sat 12 Jun 93  7:50a
  20. By: Lou Duchez
  21. To: Robert Dekelbaum
  22. Re: Decimal to hex conversion
  23. =======================================================================
  24. @MSGID: 1:157/200@fidonet.org 660ab59c
  25. RD>does andbody know an easy way to convert a byte value from it's integer
  26. RD> notation to hex notatation?
  27.  
  28. Well, thank you for this message.  It finally got me off my keister (sp?) to
  29. write a "decimal-to-hex" converter -- a project I'd been meaning to do, but
  30. never got around to.  (Technically, since I was in a seated position, I
  31. remained on my keister the whole time, but you know what I mean).  Actually,
  32. the following is not just "decimal-to-hex" -- it's decimal-to-any-base-from-
  33. 2-to-36-converter (because base 1 and below doesn't make sense, and after
  34. base 36 I run out of alphabet to represent "digits").  Here is NUBASE:
  35.  
  36. END OF QUOTE.
  37.  
  38. {---------------------------------------------------------------------------}
  39.  
  40. UNIT NUMBASE;
  41.  
  42. { convert from almost any base to decimal and back again. }
  43. { Base 62 is the maximum that support is coded for }
  44.  
  45. interface
  46.  
  47. var
  48.   NUBase_err : boolean;   { Global Unit Error var. }
  49.                           { True for String Overflow and }
  50.                           { Range Errors of characters and Base }
  51.  
  52. function dec2base(numin: longint; base, numplaces: byte): string;
  53. function base2dec(numin: string; base : byte): longint;
  54.  
  55. implementation
  56.  
  57. const
  58.   DigitChars: array[0..61] of char =
  59.   '0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz';
  60.  
  61. {---------------------------------------------------------------------------}
  62.  
  63. function dec2base(numin: longint; base, numplaces: byte): string;
  64.  
  65. var
  66.   tmpstr    : string;
  67.   remainder : byte;
  68.   negatize  : boolean;
  69.  
  70. begin
  71.  nubase_err := false;                  { set unit error boolean to false }
  72.  tmpstr := '';
  73.  negatize   := (numin < 0);            { record if it's a negative number }
  74.  if negatize then
  75.    numin    := abs(numin);             { convert to positive for calcs }
  76.  if base <> 10 then
  77.   begin
  78.    tmpstr[0]  := char(numplaces);      { set length of the output string }
  79.    while numplaces > 0 do              { Loop: fills each space in string }
  80.     begin
  81.      remainder := numin mod base;      { get next "digit" (under new base) }
  82. {
  83.      if remainder > 9 then
  84.       tmpstr[numplaces] := char(remainder + 64 - 9)   (* convert to letter *)
  85.      else
  86.       tmpstr[numplaces] := char(remainder + 48);      (* use number as is *)
  87. (*Replaced above 4 lines with below 1 to get position in const string*)
  88. }
  89.      tmpstr[numplaces] := digitchars[remainder];
  90.      numin     := numin div base;      { reduce dividend for next "pass" }
  91.      numplaces := numplaces - 1;       { go to "next" position in string }
  92.     end;                               { end of loop }
  93.    { The following: if we've run out of room on the string, or if it's a
  94.      negative number and there's not enough space for the "minus" sign,
  95.      convert the output string to all asterisks. }
  96.    if (numin <> 0) or (negatize and (tmpstr[1] <> '0')) then
  97.     begin
  98.      for numplaces := 1 to byte(tmpstr[0]) do
  99.       tmpstr[numplaces] := '*';
  100.      nubase_err := true;
  101.     end;
  102.   end
  103.  else
  104.   begin
  105.    str(numin,tmpstr);
  106.     if length(tmpstr) < numplaces then
  107.      while length(tmpstr) < numplaces do
  108.       tmpstr := '0' + tmpstr
  109.     else
  110.      if (length(tmpstr) > numplaces) or (negatize and (tmpstr[1] <> '0')) then
  111.       begin
  112.        for numplaces := 1 to byte(tmpstr[0]) do
  113.         tmpstr[numplaces] := '*';
  114.        nubase_err := true;
  115.       end;
  116.   end;
  117.  { add minus sign }
  118.  if negatize and (tmpstr[1] = '0') then
  119.   tmpstr[1] := '-';
  120.  dec2base := tmpstr;
  121. end;
  122.  
  123. {---------------------------------------------------------------------------}
  124.  
  125. function base2dec(numin: string; base : byte): longint;
  126.  
  127. var tmpstr: string;
  128.     code : integer;
  129.     remainder: longint;
  130.     temp : longint;
  131.     power : longint;
  132.     numlen : byte;
  133.     negatize: boolean;
  134.  
  135.  procedure breakdown;
  136.  
  137.   function pwr(base : longint; exponent : byte) : longint;
  138.  
  139.   var j : integer;
  140.       ptmp : longint;
  141.  
  142.   begin { pwr }
  143.    if exponent > 1 then
  144.     begin
  145.      ptmp := base;
  146.      for j := 2 to exponent do
  147.       base := base * ptmp;
  148.      pwr := base;
  149.     end
  150.    else
  151.     case exponent of
  152.      0 : pwr := 0;
  153.      1 : pwr := base;
  154.     end;
  155.   end; { of pwr }
  156.  
  157.  var x : byte;
  158.  
  159.  begin { breakdown }
  160.   for x := numlen downto 1 do
  161.    begin
  162.     temp := 0;
  163.     power := 0;
  164.     temp := pos(numin[x],digitchars) - 1;
  165.     nubase_err := temp >= base;
  166.     if (not nubase_err) then
  167.      begin
  168.       power := pwr(base, (numlen - x));
  169.       if power = 0 then
  170.        remainder := remainder + temp
  171.       else
  172.        remainder := remainder + (temp * power);
  173.      end
  174.     else
  175.      exit;
  176.    end;                                { end of loop }
  177.  end; { of breakdown }
  178.  
  179. begin { base2dec }
  180.  nubase_err := false;
  181.  negatize := (numin[1] = '-');         { record if it's a negative number }
  182.  if negatize then
  183.   begin
  184.    numin := copy(numin,2,length(numin)); { convert to positive for calcs }
  185.   end;
  186.  numlen := length(numin);
  187.  remainder := 0;
  188.  tmpstr := '';
  189.  breakdown;
  190.  str(remainder,tmpstr);
  191.  if not nubase_err then
  192.   begin
  193.    { add minus sign }
  194.    if negatize then
  195.      tmpstr := '-' + tmpstr;
  196.   end;
  197.  val(tmpstr,remainder,code);
  198.  base2dec := remainder;
  199. end; { of base2dec }
  200.  
  201. begin
  202.   nubase_err := false;
  203. end.
  204. {End Of Unit NUMBase}